home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / musik / bytes / midistdf.lst < prev    next >
Encoding:
File List  |  1989-04-05  |  14.1 KB  |  350 lines
  1. '
  2. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  3. '  Sequenzerprogramm mit Abspeichermöglichkeit als MIDI Standard File
  4. '  geschrieben in GFA-BASIC 3.5E D, (C)1993 Stephan M. Sprenger
  5. '  PROSONIQ PRODUCTS SOFTWARE, Badenwerkstraße 9, 76137 Karlsruhe
  6. ' .............................................................................
  7. '
  8. '
  9. $I+             ! Compiler-Option: Interrupts initialisieren
  10. $P>             ! Compiler-Option: GFA-Konvention für Procedures
  11. '
  12. mtc!=FALSE      ! Synchronisation: FALSE=intern, TRUE=MIDI Clock
  13. click|=1        ! Metronom: 1=Metronom an, 0=Metronom aus
  14. tempo=0.01      ! Tempo:  Aufzeichnungs- und Abspielgeschwindigkeit
  15. '
  16. @init           ! Programm initialisieren
  17. @standby        ! Hauptschleife des Programms
  18. '
  19. ' Unter-Routinen zum Programm
  20. '
  21. PROCEDURE init
  22.   OPENW 0                               ! Bildschirm und Fenster...
  23.   DEFMOUSE 0
  24.   TITLEW #1," SEQUENCER "
  25.   INFOW #1," "
  26.   OPENW #1,20,150,600,100,0
  27.   CLS
  28.   dm=FRE(0)/15
  29.   INLINE midi_buffer%,4000
  30.   @midi_buffer(midi_buffer%,4000)       ! neuen System-MIDI-Puffer einrichten
  31.   ON BREAK GOSUB alter_buffer           ! alten Puffer bei Abbruch wiederherstellen
  32.   ON ERROR GOSUB alter_buffer           ! alten Puffer bei Fehler restaurieren
  33.   DIM dat$(dm)                          ! Feld für MIDI-Daten
  34.   DIM time%(dm)                         ! Feld für Absolutzeit
  35.   DIM d_len&(300)
  36.   OPEN "O",#99,"MID:"                   ! MIDI-Schnittstelle öffnen
  37. RETURN
  38. '
  39. PROCEDURE standby
  40.   DO
  41.     INFOW #1," Status: Stand-By     "+fn$
  42.     PRINT AT(13,2),"BAR: ";1''''" BEAT: ";1'''
  43.     key$=CHR$(INP(2))
  44.     IF key$="0"
  45.       INFOW #1," Status: Playback ... "+fn$
  46.       @playback
  47.     ELSE IF key$="*"
  48.       INFOW #1," Status: Recording ... "+fn$
  49.       @record
  50.     ELSE IF key$=CHR$(27)
  51.       @alter_buffer
  52.     ELSE IF key$="s" OR key$="S"
  53.       INFOW #1," Status: Saving MIDI Standard File ... "+fn$
  54.       @convert_mid(1,1)
  55.     ELSE IF key$="l" OR key$="L"
  56.       INFOW #1," Status: Loading MIDI Standard File ... "+fn$
  57.       @convert_mid(1,0)
  58.     ELSE IF INKEY$=CHR$(13)
  59.       @all_notes_off
  60.     ELSE
  61.       CLR key$
  62.     ENDIF
  63.   LOOP
  64. RETURN
  65. '
  66. PROCEDURE record
  67.   tm=0
  68.   c%=1
  69.   VOID FRE(0)
  70.   dummy$=INPMID$                        ! MIDI-In-Puffer leeren ...
  71.   @anzeige
  72.   DO
  73.     IF mtc!=FALSE                       ! interne Synchronisation?
  74.       DELAY tempo                       ! Ja, dann Pause und...
  75.       INC tm                            ! ... Zähler erhöhen
  76.       @anzeige                          ! Position anzeigen...
  77.     ENDIF
  78.     IF INP?(3)                          ! MIDI-Daten liegen an?
  79.       in|=INP(3)                        ! Ja, dann lesen
  80.       IF in|>127                        ! Statusbyte ?
  81.         IF (in| AND &HF0)=144           ! Note-On ?
  82.           rb|=in|                       ! Statusbyte puffern
  83.           @get                          ! und Event aufzeichnen
  84.         ELSE IF (in| AND &HF0)=128      ! Note-Off ?
  85.           rb|=in|                       ! Statusbyte puffern
  86.           @get                          ! und Event aufzeichnen
  87.         ELSE IF in|=248 AND mtc!=TRUE   ! MIDI-Clock-Signal?
  88.           INC tm                        ! Ja, dann Zähler erhöhen
  89.           @anzeige                      ! Position anzeigen...
  90.         ELSE
  91.           rb|=0                         ! andere Daten außer Noten ignorieren
  92.         ENDIF
  93.       ELSE
  94.         IF rb|<>0                       ! Letztes Statusbyte war Note-On/Off?
  95.           dat$(c%)=CHR$(rb|)+CHR$(in|)+CHR$(INP(3))   ! dann Byte speichern
  96.           time%(c%)=tm                  ! Zeit speichern
  97.           INC c%                        ! Zähler erhöhen
  98.         ENDIF
  99.       ENDIF
  100.     ELSE
  101.       in|=0
  102.     ENDIF
  103.     last%=c%                            ! Variable für Spur-Ende
  104.     EXIT IF c%=>dm-1 OR INKEY$=CHR$(13)
  105.   LOOP
  106. RETURN
  107. '
  108. PROCEDURE playback
  109.   tm=0
  110.   c%=1
  111.   VOID FRE(0)
  112.   dummy$=INPMID$                        ! MIDI-In-Puffer leeren ...
  113.   DO                                    ! Wiedergabe-Schleife
  114.     IF INP?(3)
  115.       in|=INP(3)
  116.     ELSE
  117.       in|=0
  118.     ENDIF
  119.     IF in|=248 AND mtc!=TRUE            ! MIDI-Clock?
  120.       INC tm                            ! Dann Uhr +1
  121.       @anzeige
  122.     ENDIF
  123.     IF mtc!=FALSE                       ! Interne Synchronisation?
  124.       DELAY tempo                       ! Dann Uhr nach Pause +1
  125.       INC tm
  126.       @anzeige
  127.     ENDIF
  128.     IF time%(c%)<=tm                    ! nächstes Event schon dran?
  129.       PRINT #99,dat$(c%);               ! Ja, dann ausgeben
  130.       INC c%
  131.     ENDIF
  132.     EXIT IF c%=>dm-1 OR c%=>last% OR INKEY$=CHR$(13)
  133.   LOOP
  134.   @all_notes_off                        ! Nach Beendigung alle Noten aus.
  135. RETURN
  136. '
  137. PROCEDURE get
  138.   dat$(c%)=CHR$(rb|)+CHR$(INP(3))+CHR$(INP(3))   ! Byte speichern
  139.   time%(c%)=tm                                   ! Zeit speichern
  140.   INC c%                                         ! Zähler erhöhen
  141. RETURN
  142. '
  143. PROCEDURE anzeige
  144.   IF tm MOD 24=0                      ! Anzeige von Takt und Viertel
  145.     PRINT AT(13,2),"BAR: ";TRUNC(tm/96)+1''''" BEAT: ";((tm/24) MOD 4)+1'''
  146.     PRINT CHR$(7*click|);
  147.   ENDIF
  148. RETURN
  149. '
  150. PROCEDURE ende
  151.   CLOSEW 1
  152.   CLOSEW 0
  153.   CLOSE
  154.   EDIT
  155. RETURN
  156. '
  157. PROCEDURE convert_mid(abs_rel|,save_load|)
  158.   '
  159.   ' speichert/lädt Daten als MIDI Standard File:
  160.   ' MIDI-Events in dat$(), Zeit als Clicks in time%()
  161.   '
  162.   ' Wenn Sie abs_rel| auf 1 setzen, erwartet die Routine in time%() die
  163.   ' Zeitangabe als Absolutzeit (also als Zeit seit Spuranfang); ist
  164.   ' abs_rel| Null, dann erwartet die Routine in time%() die seit dem
  165.   ' vorhergehenden Event verstrichene Zeit.
  166.   '
  167.   ' In dat$() befinden sich die zu speichernden MIDI-Events; diese müssen
  168.   ' pro Eintrag vollständig sein (ein Note-On liegt hier z.B. als
  169.   ' dat$(2)=CHR$(144)+CHR$(60)+CHR$(64) vor).
  170.   '
  171.   ' Wenn save_load|=1 ist wird gespeichert, bei save_load|=0 wird geladen
  172.   '
  173.   @convert_init                         ! Konvertierungsroutine einrichten
  174.   dummy$=INKEY$
  175.   FILESELECT "A:\*.MID","MIDIFILE.MID",fn$
  176.   DEFMOUSE 2
  177.   IF fn$="" OR fn$="\"
  178.     GOTO cancel
  179.   ENDIF
  180.   IF save_load|=1
  181.     OPEN "O",#1,fn$
  182.     PRINT #1,"MThd";                      ! **** Header-Block-Kennung ****
  183.     PRINT #1,MKL$(6);                     ! Länge des Headers
  184.     PRINT #1,MKI$(0);                     ! File Format (0)
  185.     PRINT #1,MKI$(1);                     ! Anzahl der Spuren
  186.     PRINT #1,MKI$(&H18);                  ! 24 Clicks pro Viertelnote (MIDI Clock)
  187.     PRINT #1,"MTrk";                      ! ***** Spur-Block-Kennung *****
  188.     PRINT #1,MKL$(0);                     ! Platzhalter für Blocklänge
  189.     PRINT #1,CHR$(0);                     ! Delta-Time des ersten Events
  190.     PRINT #1,CHR$(&HFF);                  ! Meta-Event: Spurname
  191.     PRINT #1,MKI$(&H108);                 ! (01=Text, 08=Textlänge)
  192.     PRINT #1,"MIDIFILE";                  ! Spurname
  193.     c%=0
  194.     DO
  195.       INC c%
  196.       VOID FRE(0)
  197.       r%=V:r$
  198.       IF abs_rel|=1                         ! time%() enthält Absolutzeit
  199.         LPOKE r%+6,(time%(c%)-time%(c%-1))  ! Zeit zwischen zwei Events
  200.       ELSE
  201.         LPOKE r%+6,time%(c%)                ! time%() enthält Delta-Time
  202.       ENDIF
  203.       POKE r%+2,1                           ! Opcode: 1=DEZ-->VLN, 0=VLN-->DEZ
  204.       d0=C:r%()                             ! VLN-Routine aufrufen
  205.       FOR b|=0 TO 3                         ! Bytes in Datei schreiben...
  206.         IF PEEK(r%+6+b|)<>0
  207.           PRINT #1,CHR$(PEEK(r%+6+b|));
  208.         ENDIF
  209.       NEXT b|
  210.       PRINT #1,dat$(c%);                    ! MIDI-Daten in Datei ausgeben
  211.       EXIT IF c%=last%                      ! Abbrechen wenn Spurende
  212.     LOOP
  213.     PRINT #1,CHR$(0);                       ! Delta-time% zum Spurende
  214.     PRINT #1,CHR$(&HFF);MKI$(&H2F00);       ! Meta-Event: Spurende
  215.     CLOSE #1
  216.     OPEN "U",#1,fn$                         ! Datei nochmals öffnen
  217.     l%=LOF(#1)                              ! Länge ermitteln
  218.     SEEK #1,18                              ! Byte #18 anfahren
  219.     PRINT #1,MKL$(l%-18);                   ! Spurlänge eintragen
  220.   ELSE
  221.     c%=0                                   ! Zähler für Feldindex
  222.     z%=0                                   ! Zähler für Absolutzeit
  223.     b%=0                                   ! Zähler für gelesene Bytes
  224.     evt$=""
  225.     OPEN "I",#1,fn$                       ! Datei zum Lesen öffnen
  226.     id$=INPUT$(4,#1)                      ! Header-ID lesen
  227.     h_l%=CVL(INPUT$(4,#1))                ! Header-Länge lesen
  228.     ff&=CVI(INPUT$(2,#1))                 ! File-Typ lesen
  229.     anz&=CVI(INPUT$(2,#1))                ! Spuranzahl
  230.     res&=CVI(INPUT$(2,#1))                ! Auflösung
  231.     IF id$<>"MThd" OR ff%<>0              ! MIDI-File vom Typ 0?
  232.       ALERT 3,"Ungültiges Fileformat - |Fileheader",1," OK ",r
  233.       GOTO cancel                         ! Nein, dann Abbruch
  234.     ENDIF
  235.     id$=INPUT$(4,#1)                      ! Track-ID lesen
  236.     b_l%=CVL(INPUT$(4,#1))                ! Länge der Spur
  237.     IF id$<>"MTrk"                        ! Track-ID prüfen
  238.       ALERT 3,"Ungültiges Fileformat - |Trackstruktur",1," OK ",r
  239.       GOTO cancel                         ! Ungültig? dann raus
  240.     ENDIF
  241.     DO                                    ! Leseschleife
  242.       INC c%                              ! Zähler für Feld erhöhen
  243.       t$=""
  244.       DO                                  ! Leseschleife für Zeit
  245.         tim$=INPUT$(1,#1)                 ! Erstes Byte lesen
  246.         INC b%                            ! Bytezähler +1
  247.         t$=t$+tim$                        ! ersten Zeitwert bilden
  248.         EXIT IF ASC(tim$)<128             ! raus, wenn LSB gelesen
  249.       LOOP
  250.       VOID FRE(0)
  251.       t$=MID$(t$,1,4)
  252.       t$=STRING$(4-LEN(t$),0)+t$          ! Langwort bilden
  253.       r%=V:r$                             ! Adresse der Maschinenroutine
  254.       POKE r%+2,0                         ! Opcode: 0=VLN-->DEZ
  255.       LPOKE r%+6,CVL(t$)                  ! Wert übergeben
  256.       d0=C:r%()                           ! Maschinenprogramm aufrufen
  257.       IF abs_rel|=0                       ! Relative Zeit benötigt?
  258.         time%(c%)=LPEEK(r%+6)/(res&/24)   ! dann Delta-Time ablegen
  259.       ELSE                                ! Absolutzeit?
  260.         z%=z%+LPEEK(r%+6)                 ! dann Zeit bilden...
  261.         time%(c%)=z%/(res&/24)            ! ...und in interne Auflösung umrechnen
  262.       ENDIF
  263.       evt$=INPUT$(1,#1)                   ! Event, erstes Byte lesen
  264.       INC b%                              ! wieder ein Byte mehr...
  265.       rb|=(ASC(evt$)) AND &HF0            ! nur Hi-Nibble wird benötigt
  266.       IF d_len&(rb|)=0                    ! Event-Typ ist nicht bekannt?
  267.         ALERT 3,"ERROR:|Unbekanntes MIDI-Event",1,"CANCEL",r
  268.         EXIT IF r=1                       ! dann nix wie raus...
  269.       ENDIF
  270.       IF evt$=CHR$(&HFF)                  ! Event ist Meta-Event...
  271.         m_type&=ASC(INPUT$(1,#1))         ! ...dann Event-Typ feststellen
  272.         m_l&=ASC(INPUT$(1,#1))            ! Länge feststellen
  273.         RELSEEK #1,m_l&                   ! Meta-Event ignorieren...
  274.         b%=b%+m_l&+2                      ! ...und überspringen
  275.         EXIT IF m_type&=&H2F              ! raus wenn Meta-Event = Spurende
  276.       ELSE
  277.         dat$(c%)=evt$+INPUT$(d_len&(rb|)-1,#1) ! wenn normales MIDI-Event...
  278.         b%=b%+d_len&(rb|)                 ! ... dann lesen und speichern
  279.       ENDIF
  280.     LOOP
  281.     last%=c%                              ! Spurende
  282.   ENDIF
  283. cancel:
  284.   CLOSE #1                                ! Datei schließen
  285.   DEFMOUSE 0                              ! Biene wegzaubern
  286. RETURN
  287. '
  288. PROCEDURE convert_init
  289.   '
  290.   ' Initialisierung der VLN/Dezimal-Routine.
  291.   ' Die in r$ abgelegte Maschinenroutine erwartet in V:r$+2 als Byte den
  292.   ' Opcode der auszuführenden Berechnung (0=VLN in Dezimalwert umrechnen,
  293.   ' 1=Dezimalwert in VLN umrechnen) und in V:r$+6 den umzurechnenden Wert.
  294.   ' Nach Aufruf der Routine kann von dort auch der berechnete Wert gelesen
  295.   ' werden (Langwort). Die Wertübergabe über die Speicherstelle habe ich
  296.   ' gewählt, weil die Übergabe über den Stack bei meiner GFA-Version nicht
  297.   ' korrekt funktioniert.
  298.   '
  299.   r$=MKL$(&H60080000)+MKL$(0)+MKL$(&H41FA)+MKL$(&HFFF62228)
  300.   r$=r$+MKL$(&H44A10)+MKL$(&H6754B2BC)+MKL$(&HFFFFFFF)+MKL$(&H62407003)
  301.   r$=r$+MKL$(&HE389E209)+MKL$(&H8810007)+MKL$(&HB07C0003)+MKL$(&H67084A01)
  302.   r$=r$+MKL$(&H670408C1)+MKL$(&H71401)+MKL$(&HE09AE089)+MKL$(&H51C8FFE2)
  303.   r$=r$+MKL$(&H8020017)+MKL$(&H670408C2)+MKL$(&HF0802)+MKL$(&H1F6706)
  304.   r$=r$+MKL$(&H820080)+MKL$(&H80002142)+MKL$(&H47000)+MKL$(&H4E75217C)
  305.   r$=r$+MKL$(&HFFFFFFF7)+MKL$(&H470FF)+MKL$(&H4E75B2BC)+MKL$(&HFFFFFFF7)
  306.   r$=r$+MKL$(&H62167003)+MKL$(&H1401EE9A)+MKL$(&HE08951C8)+MKL$(&HFFF8E89A)
  307.   r$=r$+MKL$(&H2820FFF)+MKL$(&HFFFF60CE)+MKL$(&H217C0FFF)+MKL$(&HFFFF0004)
  308.   r$=r$+MKL$(&H70FF4E75)
  309.   '
  310.   '
  311.   d_len&(128)=3                         ! Note-Off,Befehlslänge 3 Bytes
  312.   d_len&(144)=3                         ! Note-On, Befehlslänge 3 Bytes
  313.   d_len&(160)=3                         ! Poly Pressure
  314.   d_len&(176)=3                         ! Control Change
  315.   d_len&(192)=2                         ! Program Change
  316.   d_len&(208)=2                         ! Channel Pressure
  317.   d_len&(224)=3                         ! Pitch Wheel Change
  318.   d_len&(&HF0)=&HFF                     ! Meta-Event darf keinen Fehler erzeugen
  319.   '
  320.   ' Es können hier weitere Befehlslängen für MIDI-Nachrichten eingetragen werden
  321.   '
  322. RETURN
  323. '
  324. PROCEDURE midi_buffer(neue_adresse%,laenge%)
  325.   adresse%=XBIOS(14,2)
  326.   alte_buffer_adresse%=LPEEK(adresse%)
  327.   SLPOKE adresse%+6,0
  328.   SLPOKE adresse%,neue_adresse%
  329.   SDPOKE adresse%+4,laenge%
  330. RETURN
  331. '
  332. PROCEDURE alter_buffer
  333.   adresse%=XBIOS(14,2)
  334.   SLPOKE adresse%,alte_buffer_adresse%
  335.   alte_buffer_adresse%=0
  336.   alter_buffer%=0
  337.   @ende                         ! Programm verlassen
  338. RETURN
  339. '
  340. PROCEDURE all_notes_off
  341.   FOR chan|=0 TO 15             ! Alle Kanäle durchgehen...
  342.     FOR note|=0 TO 127          ! Alle Noten durchgehen...
  343.       IF note|=0                ! Erstes Note-Off normal..
  344.         OUT 3,128+chan|
  345.       ENDIF
  346.       OUT 3,note|,0             ! ..den Rest im Running-Mode
  347.     NEXT note|                  ! senden (geht schneller)
  348.   NEXT chan|
  349. RETURN
  350.